package PpLocator::Controller::PpLocator;
# by Tao Lang: langtao123xxx@126.com
use Mojo::Base 'Mojolicious::Controller';

use File::Path qw/remove_tree/;
use File::Basename;
use Scalar::Util qw/looks_like_number/;
use Config::Tiny;

# 私有模块
use JsonConf qw/get_conf load_done update_done init_conf_file/;
use WriteData qw/write_data2file/;
use CheckParam qw/is_valid_numeric_param/;

# -----------------------------------------------
# mod_perl
our $home_dir = $ENV{MOJO_HOME};
$home_dir = '.' unless (defined $home_dir and -d $home_dir);

# 干脆顶层全用 our 得了，这些变量似乎都在子函数中有调用
our $conf_dir = join '/', $home_dir, 'conf/pp_locator';
our $conf_dir_species = "$conf_dir/species";
# 供数据来源页面表格
our $ini_data_source = "$conf_dir/data_source.ini";

# 先读基础配置
my $main_conf = join '/', $conf_dir, 'pp_locator.json';
# 初始化配置
init_conf_file($main_conf);
our $conf = get_conf($main_conf);
our $data_dir = join '/', $home_dir, $conf->{data_dir};
# web 可直接访问，注意必然是在 public 父目录下的
our $public_tmp_dir = join '/', $home_dir, $conf->{public_tmp_dir}; 
our $days_kept = $conf->{days_kept}; # 保存天数
our $short_seq_length = $conf->{blastn_short};
# -----------------------------------------------
# 服务首页
sub index {
    my $self = shift;

    my $default_species;
    if (default_species_ok()) {
        $default_species = $conf->{default_species};
    }
    $self->render(conf => $conf, species_available => [ species_available() ], default_species => $default_species);
}

# 默认输出染色体 blastdb 信息
# 可以选择输出染色体长度信息
sub chromosome {
    my $self = shift;
    my $validation = $self->validation;
    $validation->required('species')->in(species_available());
    return $self->render(json => {}) if $validation->has_error;

    my $species = $self->param('species');
    load_conf_of_species($species);

    $validation->required('bp')->like(qr/^[1-9]\d*$/);
    return $self->render(
        json => $conf->{species}{$species}{blastdb}{chromosome}
    ) if $validation->has_error;

    return $self->render(json => chr_len($species));
}

# 返回染色体长度
sub chr_len {
    my($species, $chromosomes) = @_;
    
    load_conf_of_species($species) unless exists $conf->{species}{$species};
    my $href = $conf->{species}{$species}{chromosome_length};
    my %lens;
    for my $subG (keys %$href) {
        for my $n (0 .. $#{ $href->{$subG} }) {
            my $hgrp = $n + 1;
            my $cname = $hgrp . $subG;
            $lens{$cname} = $href->{$subG}[$n];
        }
    }
    my %tmp;
    if (defined $chromosomes and (ref $chromosomes eq 'ARRAY')) {
        @tmp{@$chromosomes} = @lens{@$chromosomes};
    } else {
        %tmp = %lens;
    }
    
    return \%tmp;
}

sub blastn {
    my $self = shift;

    remove_old_jobs();
    
    # Check if parameters have been submitted
    my $validation = $self->validation;
    return $self->redirect_to('/pp_locator') unless $validation->has_data;

    # querySeq
    # 考虑万一并没有从网页输入
    $validation->required('querySeq')->like(qr/^[[:ascii:]]+$/);
    return $self->render('wrong_params', msg => 'Enter Query Sequence: You entered strange characters! Must be ASCII code!') if $validation->has_error;

    my $good_pps = filter_invalid_pps(\$self->param('querySeq'), $conf->{max_num_of_pp});
    
    unless (@$good_pps) {
        return $self->render(
            template => 'pp_locator/no_valid_query_data',
            query_data => $self->param('querySeq')
        );
    }
    
    # species, chromosomes
    $validation->required('species')->in(species_available());
    return $self->render('wrong_params', msg => 'Please select a species!') if $validation->has_error;
    $validation->required('chrs[]');
    return $self->render('wrong_params', msg => 'Please select at least one chromosome!') if $validation->has_error;
    my $species = $self->param('species');
    load_conf_of_species($species);
    my $chromosomes = $self->every_param('chrs[]');
    # 在 done.json 中写入染色体长度
    my $lens = chr_len($species, $chromosomes);

    # blastn 参数，有默认值
    my $perc_identity = $self->param('perc_identity');
    $perc_identity = 70 unless is_valid_numeric_param($perc_identity, 0, 100);
    my $qcov_hsp_perc = $self->param('qcov_hsp_perc');
    $qcov_hsp_perc = 70 unless is_valid_numeric_param($qcov_hsp_perc, 0, 100);
    my $evalue = $self->param('evalue');
    $evalue = 10 unless (defined $evalue and $evalue >= 0);
    my $evalue_short = $self->param('evalue_short');
    $evalue_short = 1000 unless (defined $evalue_short and $evalue_short >= 0);
    my $word_size = $self->param('word_size');
    $word_size = 11 unless (defined $word_size and $word_size >= 4);
    my $word_size_short = $self->param('word_size_short');
    $word_size_short = 7 unless (defined $word_size_short and $word_size_short >= 4);
    my $dust = $self->param('dust');
    $dust = 0 unless (defined $dust);
    # 万一脚本 post 了
    $validation->required('specifiers[]');
    return $self->render('wrong_params', msg => 'Please select specifiers!') if $validation->has_error;
    my @specifiers = @{ $self->every_param('specifiers[]') };
    my @default_specifiers = grep {
        exists $conf->{ofmt_specifiers}{required}{$_}
        or
        exists $conf->{ofmt_specifiers}{optional}{$_}
    } split /\s+/, $conf->{ofmt};

    my %info;
    # 任务 id，根据 id 新建文件夹
    my $job_id = new_job(time); # 这里根据时间戳来得到不重复数字
    $info{status} = 'blastn'; # 当前进行中的任务
    @info{qw/species chromosomes chr_lens/} = ($species, $chromosomes, $lens);
    @info{qw/perc_identity qcov_hsp_perc evalue evalue_short word_size word_size_short dust/} = ($perc_identity, $qcov_hsp_perc, $evalue, $evalue_short, $word_size, $word_size_short, $dust);
    @{ $info{ids} } = map { $_->{id} } @$good_pps;

    # 有必要，后面处理 blast 结果需要
    unless (join(' ', sort @specifiers) eq join(' ', sort @default_specifiers)) {
        # conf 里的 ofmt 必须设置正确，设置不正确就自己滚蛋吧。
        $info{ofmt} = $conf->{ofmt};
        # 删除被勾选取消的默认设定项
        for my $s (@default_specifiers) {
            unless (grep { $s eq $_ } @specifiers) {
                $info{ofmt} =~ s/\b$s\b//g;
            }
        }
        # 添上新勾选的设定项
        for my $s (@specifiers) {
            unless (grep { $s eq $_ } @default_specifiers) {
                $info{ofmt} .= " $s";
            }
        }
        # 去除多余空白
        $info{ofmt} =~ s/\s+/ /g;
    }
    # 将信息存到 done.json 里
    update_done(\%info, $job_id, $public_tmp_dir);

    # 准备数据，以便写入 data/TMP 下
    my ($fa_blastn,$fa_short) = prepare_fasta($good_pps);
    write_data2file($fa_blastn, "$data_dir/$job_id/blastn.fa") if ($$fa_blastn =~ />\S+/);
    write_data2file($fa_short, "$data_dir/$job_id/blastn-short.fa") if ($$fa_short =~ />\S+/);

    # 准备执行 blastn
    system "export MOJO_HOME=$home_dir; $home_dir/script/primer-b2chrs.pl --jid $job_id &";

    $self->redirect_to("/pp_locator/job_status?jid=$job_id");
}

sub job_status {
    my $self = shift;

    # Check if parameters have been submitted
    my $validation = $self->validation;
    return $self->render('pp_locator/view_job', days_kept => $days_kept) unless $validation->has_data;
    # 必须包含 jid
    $validation->required('jid')->like(qr/^\w+$/);
    return $self->render('pp_locator/view_job', days_kept => $days_kept) if $validation->has_error;

    my $jid = $self->param('jid');

    if (-d "$data_dir/$jid") {
        # 加载 done.json 内数据
        my $done = load_done($jid, $public_tmp_dir);

        # 查看是否 blastn 完
        my $check = $self->param('check');
        if ($check) {
            return $self->render(json => { status => $done->{status} });
        }

        return $self->render(jid => $jid, done => $done, days_kept => $days_kept);
    } else {
        return $self->render(template => 'pp_locator/job_not_exist', jid => $jid, days_kept => $days_kept);
    }
}

# species, cname, batch
sub blastdbcmd {
    my $self = shift;
    my $validation = $self->validation;
    $validation->required('species')->in(species_available());
    $validation->required('cname')->like(qr/^\w+$/);
    $validation->required('batch')->like(qr/^[\w,;]+$/);
    return $self->render(json => {}) if $validation->has_error;

    my $species = $self->param('species');
    my $cname = $self->param('cname');
    my $batch = $self->param('batch');

    load_conf_of_species($species);
    my $bdb = $conf->{species}{$species}{blastdb};
    
    my $chrom = $bdb->{chromosome};
    my %dbname_sid;
    for my $subG (keys %$chrom) {
        for my $hgrp (keys %{$chrom->{$subG}}) {
            $dbname_sid{ $hgrp . $subG} = $chrom->{$subG}{$hgrp};
        }
    }
    return $self->render(json => {}) if not exists $dbname_sid{$cname};
    my $dbname = join '/', $bdb->{db_dir}, $dbname_sid{$cname}[0];
    my $sid = $dbname_sid{$cname}[1];

    my %id_map;
    for my $entry (split /;/, $batch) {
        my @r = split /,/, $entry;
        next if @r < 3;
        my($id,$s,$e) = @r;
        next unless $id =~ /\w/;
        next unless ($s > 0 and $e >= $s);
        $id_map{"$sid:$s-$e"} = $id;
    }

    return $self->render(json => {}) unless %id_map;
    my @ks = keys %id_map;
    my @row = map { s/:/ /; $_ } @ks;
    my $ctnt = join "\n", @row;

    my $f_batch = tmp_file('','.txt');

    write_data2file(\$ctnt, $f_batch);
    my %seq;
    {
        open my $fh, "blastdbcmd -db $dbname -entry_batch $f_batch |" or die $!;
        local $/ = '>';
        while (<$fh>) {
            chomp;
            next if /^\s*$/;
            my($header_line,$dna) = split /\n/, $_, 2;
            my $tid = (split /\s+/, $header_line)[0];
            $dna =~ s/\s//g;
            $seq{ $id_map{$tid} } = $dna;
        }
        close $fh or die $!;
    }
    unlink $f_batch; # 删除临时文件
    
    return $self->render(json => \%seq);
}

sub plot {
    my $self = shift;
    my $default_species;
    if (default_species_ok()) {
        $default_species = $conf->{default_species};
    }
    $self->render(species_available => [ species_available() ], default_species => $default_species);
}

sub default_species_ok {
    return 0 unless (exists $conf->{default_species});
    return 0 unless (grep { $conf->{default_species} eq $_ } species_available());
    return 1;
}

sub prepare_fasta {
    my $good_pps = shift;
    my($fa_blastn,$fa_short) = ('', '');
    for my $pp (@$good_pps) {
        for my $fr (qw/F R/) {
            my $dna = $pp->{$fr};
            if (length $dna >= $short_seq_length) {
                $fa_blastn .= ">$pp->{id}_$fr\n$dna\n";
            } else {
                $fa_short .= ">$pp->{id}_$fr\n$dna\n";
            }
        }
    }
    return (\$fa_blastn, \$fa_short);
}

# 获取不重复的 job_id，并依此来建立文件夹
sub new_job {
    my $n = shift;
 
    my $jid = sprintf "t%x", $n; # 加个 t，表示 tmp
    while (-e "$data_dir/$jid") {
        $n++;
        $jid = sprintf "t%x", $n;
    }
    mkdir $data_dir . '/' . $jid;

    # public/TMP 目录下同时新建一个
    my $public_job_dir = "$public_tmp_dir/$jid";
    mkdir $public_job_dir unless -d $public_job_dir;

    return $jid;
}

# 在 data/TMP 下创建临时文件
sub tmp_file {
    my($prefix, $suffix) = @_;
    my $n = time;
    my $fname = sprintf "%s/%s%x%s", $data_dir, $prefix, $n, $suffix;
    while (-e $fname) {
        $n++;
        $fname = sprintf "%s/%s%x%s", $data_dir, $prefix, $n, $suffix;
    }
    # 有可能有临时文件没能及时删除，专门检查下
    rm_old_tmp_text_files($suffix); # 清理太旧的文件
    system "touch $fname";
    return $fname;
}

# pps: primer pairs
# 在这里取比如前 20 项
# 且 Id 不重复，若重复，保留第一个
sub filter_invalid_pps {
    my ($pps_str_ref, $max_num) = @_;
    my @good_pps;
    my %ids;
    for my $pp (split /\n/, $$pps_str_ref) {
        $pp =~ s/^\s+|\s+$//g;
        my($id,$sF,$sR) = split /\s+/, $pp, 3;
        next if $id =~ /[^\w\-.]/; # id 还是管管，主要是文件名的问题
        next if $sF =~ /[^acgtn]/i;
        next if $sR =~ /[^acgtn]/i;
        next unless primer_length_ok($sF) and primer_length_ok($sR);
        next if exists $ids{$id}; # 避免重名
        push @good_pps, {id => $id, F => $sF, R => $sR};
        $ids{$id} = 1;
        last if $max_num > 0 and @good_pps == int($max_num);
    }
    return \@good_pps;
}

sub primer_length_ok {
    my $dna = shift;
    my $slen = length $dna;
    # 不检查那么细吧，愿意在配置文件里乱搞的话就随他
    # p => primer
    my ($min_p_len, $max_p_len) = @{ $conf->{primer_length} }{qw/min max/};
    return 1 if ($slen >= $min_p_len and $slen <= $max_p_len);
    return 0;
}

# 是否直接按照 job_id 转换来的十进制时间来删除？
# 按照上一次修改时间来删除
sub remove_old_jobs {
    my @dirs = glob "$data_dir/*";
    my @dirs_pub_tmp = glob "$public_tmp_dir/*";

    @dirs = (@dirs, @dirs_pub_tmp);

    return unless @dirs; # 空的，直接返回

    for my $d (@dirs) {
        my $jid = basename($d);
        next unless $jid =~ /^t/; # 只删除 tmp 的
        next unless -d $d; # 只删除旧目录
        next unless -O $d; # File is owned by real uid.
        
        # 按照修改时间？
        if ( time() - ( stat($d) )[9] > (60*60*24*$days_kept) ) {
            remove_tree($d);
        }
    }

    return 0;
}

# 清除时间较久的临时文本文件
sub rm_old_tmp_text_files {
    my $suffix = shift;
    for my $f (glob "$data_dir/*$suffix") {
        # 按照修改时间
        if ( time() - ( stat($f) )[9] > (60*60*24*$days_kept) ) {
            unlink $f;
        }
    }

    return 0;
}

# 减少不必要的加载
# 2021.5.14 - 写成公共函数然后调用划不来，反而增加了字符量
sub species_available {
    my @conf_files = <$conf_dir_species/*.json>;
    
    # 如果一个配置文件都没有，初始化一下
    init_conf_file("$conf_dir_species/example.json") unless @conf_files;

    return map { basename($_, '.json') } @conf_files;
}

sub load_conf_of_species {
    my $species = shift;
    my $f = join '/', $conf_dir_species, "$species.json";
    $conf->{species}{$species} = get_conf($f);

    return $conf;
}

# -----------------------------------------------
# docs
sub about {
    my $self = shift;
    $self->render;
}

sub help {
    my $self = shift;
    $self->render(conf => $conf);
}

sub contact {
    my $self = shift;
    $self->render;
}

sub update_log {
    my $self = shift;
    $self->render;
}

# description, source_text, source_link, article_text, article_link
sub data_source {
    my $self = shift;
    my $ini = Config::Tiny->read($ini_data_source, 'utf8');
    my %h;
    for my $n (keys %$ini) {
        my $t1 = $ini->{$n};
        $h{$n} = {
            description => (exists $t1->{description}) ? $t1->{description} : '',
            source_text => (exists $t1->{source_text}) ? $t1->{source_text} : (
                (exists $t1->{source_link}) ? $t1->{source_link} : ''
            ),
            source_link => (exists $t1->{source_link}) ? $t1->{source_link} : '',
            article_text => (exists $t1->{article_text}) ? $t1->{article_text} : (
                (exists $t1->{article_link}) ? $t1->{article_link} : ''
            ),
            article_link => (exists $t1->{article_link}) ? $t1->{article_link} : '',
        };
    }
    $self->render(ini => \%h);
}

1;
